{ Videokiosk
  mainpanel.pas

  Copyright (C) 2010 Malcolm Poole <mgpoole@users.sourceforge.net>

  This source is free software; you can redistribute it and/or modify it under
  the terms of the GNU General Public License as published by the Free
  Software Foundation; either version 3 of the License, or (at your option)
  any later version.

  This code is distributed in the hope that it will be useful, but WITHOUT ANY
  WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  details.

  A copy of the GNU General Public License is available on the World Wide Web
  at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
  to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  MA 02111-1307, USA.
}
unit mainpanel;

{$mode objfpc}{$H+}

interface

uses
  Classes, Sysutils, Fileutil, Lresources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, ExtCtrls, Buttons, UTF8Process, Menus, Process;

type

  { TControlButton }

  TControlButton = class ( TBitBtn )
  private
    fAction: integer;
    fTarget: string;
  protected
    procedure TextChanged; override;
  public
    constructor Create(TheOwner: TComponent); override;
    property Target: string read fTarget write fTarget;
    property Action: integer read fAction write fAction;
  end;

  { TControlPanel }

  TControlPanel = class (TPanel)
  private
    fBackground: TImage;
  public
    ButtonList: TList;
    LabelList: TList;
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; Override;
    property Background: TImage read fBackground write fBackground;

  end;

  { TVideoPlayer }

  TVideoPlayer = class ( TWinControl )
   private
    FFilename: string;
    fPlayerProcess: TProcessUTF8;
    FLoop: integer;
    FMPlayerPath: string;
    FPaused: boolean;
    FVolume: integer;
    procedure SetFilename(const AValue: string);
    procedure SetLoop(const AValue: integer);
    procedure SetMPlayerPath(const AValue: string);
    procedure SetPaused(const AValue: boolean);
    procedure OnReadTimer(Sender: TObject);
    procedure Setvolume ( const Avalue: Integer ) ;
    procedure ReadMPlayerOutput;
  public
    ReadTimer: TTimer;
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure SendMPlayerCommand(Cmd: string); // see: mplayer -input cmdlist and http://www.mplayerhq.hu/DOCS/tech/slave.txt
    function Running: boolean;
    procedure Play;
    procedure Stop;
    function Playing: boolean;
  public
    property Filename: string read FFilename write SetFilename;
    property MPlayerPath: string read FMPlayerPath write SetMPlayerPath;
    property Paused: boolean read FPaused write SetPaused;
    property Loop: integer read FLoop write SetLoop; // -1 no, 0 forever, 1 once, 2 twice, ...
    property Volume: integer read FVolume write SetVolume;
  end;


  { TControlScreen }

  TControlScreen = class ( Tform )
    procedure Button1click ( Sender: Tobject ) ;
    procedure Formclose ( Sender: Tobject; var Closeaction: Tcloseaction ) ;
    procedure Formcreate ( Sender: Tobject ) ;
    procedure Formdestroy ( Sender: Tobject ) ;
    procedure Formkeypress ( Sender: Tobject; var Key: Char ) ;
    procedure DoAction (Sender: Tobject);
    procedure Formshow ( Sender: Tobject ) ;
    procedure ConfigButtonClick ( Sender: Tobject ) ;
    Procedure Playfile( Filename: string );
    procedure QuitButtonClick(Sender: TObject);
  private
    { private Declarations }
    IdleTimer: TTimer;
    fScreenList: TList;
    fCurrentScreen:integer;
    fIdleTime: integer;
    fResetInterval: integer;
    procedure DeleteScreens;
    function Getidletimerenabled: Boolean;
    procedure OnIdleTimer( Sender: TObject );
    procedure Setidletimerenabled ( const Avalue: Boolean ) ;
    procedure ShowScreen(screenIndex: integer);
    procedure LogAction(actionstr: string);
  public
    { public Declarations }
    VideoBackground: TFilename;
    VideoPlayer: TVideoPlayer;
    ConfigChecked: Boolean;
    procedure PrepareScreens (ConfigFile: TFilename );
    procedure OpenConfiguration;
    property ScreenReset : Boolean read GetIdleTimerEnabled write SetIdleTimerEnabled;
    property ResetInterval: integer read fIdleTime write fIdleTime;
  end; 

var
  ControlScreen: TControlScreen;
  inputConf:string;


implementation

uses screenconfig, background, about;

procedure debugln(astring:string);
begin
  {$IFDEF LINUX}
  writeln(astring);
  {$ENDIF}
end;



{ TControlScreen }

procedure TControlScreen.Formkeypress ( Sender: Tobject; var Key: Char ) ;
begin
//  ShowMessage(IntToStr(Ord(Key)));
  if Key=#1 then AboutForm.ShowModal;  //Ctrl-A
  if Key=#17 then Close;   //Ctrl-Q
  if Key=#24 then Close;   //Ctrl-X
  if Key=#6 then          //Ctrl-F
     begin
       if WindowState=wsMaximized
          then WindowState := wsNormal
       else WindowState := wsMaximized;
        //MenuPanel.Visible := WindowState<>wsMaximized;
       if WindowState=wsNormal then
           begin
             Screen.Cursor := crDefault;
             BorderStyle:=bsSizeable;
           end
       else
           begin
             Screen.Cursor := crNone;
             BorderStyle := bsNone;
           end;
     end;
  if Key=#19 then     // Ctrl-S
      OpenConfiguration;
  if Key=#27 then    // Esc
     begin
       if VideoPlayer.Running
          then VideoPlayer.fPlayerProcess.Terminate(0);
     end;
End;

procedure Tcontrolscreen.Doaction ( Sender: Tobject ) ;
begin
  Case TControlButton(Sender).Action of
       0: begin
            if StrToInt(TControlButton(Sender).Target) < 0 then exit;
            ShowScreen(StrToInt(TControlButton(Sender).Target));
            LogAction(FormatDateTime('ddd d mmm hh:nn:ss ', Now) + ConfigForm.Screens[StrToInt(TControlButton(Sender).Target)].Name);
          end;
       1: begin
            Playfile(TControlButton(Sender).Target);
            LogAction(FormatDateTime('ddd d mmm hh:nn:ss ', Now) + TControlButton(Sender).Target);
          end;
  end;
  fIdleTime := 0;
end;

procedure Tcontrolscreen.Formshow ( Sender: Tobject ) ;
var
  Noconfigmessage: String;
begin
  NoConfigMessage := 'No control buttons have been set up,' +#10#10
                     + 'To set up buttons and other settings press Ctrl+S' + #10
                     + 'To exit the program press Ctrl+X';
  if not ConfigChecked then
  if not FileExistsUTF8(SettingsDir + DEFAULTCONFIG)
     then ShowMessage(Noconfigmessage);
  ConfigChecked := true;
End;

procedure Tcontrolscreen.ConfigButtonClick ( Sender: Tobject ) ;
begin
  if ConfigForm.ShowModal=mrOK then
     begin
       DeleteScreens;
       PrepareScreens('');
     end;
End;

procedure Tcontrolscreen.Playfile ( Filename: String ) ;
begin
  VideoPlayer.Filename := Filename;
  VideoPlayer.Play;
end;

procedure TControlScreen.QuitButtonClick(Sender: TObject);
begin
  if VideoPlayer.Running
     then VideoPlayer.Stop;
  //Sleep(800);
  Close;
end;

procedure Tcontrolscreen.Deletescreens;
var
  X: Integer;
begin
  for x := fScreenList.Count-1 downto 0 do
      begin
        TControlPanel(fScreenList[x]).Free;
        fScreenList.Delete(x);
      end;
end;

function Tcontrolscreen.Getidletimerenabled: Boolean;
begin
  Result := IdleTimer.Enabled;
End;

procedure Tcontrolscreen.Onidletimer ( Sender: Tobject ) ;
begin
  if fCurrentScreen<1 then exit;
  if not VideoPlayer.Running then
     begin
      Inc(fIdleTime);
      if fIdleTime=fResetInterval
         then if fCurrentScreen>0
            then begin
                   ShowScreen(0);
                   LogAction('Reset menu');
                 end;
      end;
end;

procedure Tcontrolscreen.Setidletimerenabled ( const Avalue: Boolean ) ;
begin
  if Idletimer.Enabled = Avalue then Exit;
  Idletimer.Enabled := Avalue;
end;

procedure Tcontrolscreen.Showscreen ( Screenindex: Integer ) ;
begin
  if Screenindex=fCurrentScreen then exit;
  TControlPanel(fScreenList[Screenindex]).Visible := true;
  TControlPanel(fScreenList[fCurrentScreen]).Visible := false;
  fCurrentScreen := Screenindex;
end;

procedure Tcontrolscreen.Logaction ( Actionstr: String ) ;
var
  F: textfile;
begin
  if not ConfigForm.LogCheckBox.Checked then exit;
  AssignFile(F, ConfigForm.LogFileNameEdit.FileName);
  if FileExistsUTF8(ConfigForm.LogFileNameEdit.FileName)
     then Append(F)
     else Rewrite(F);
  writeln(F, Actionstr);
  Closefile(F);
end;

procedure Tcontrolscreen.Preparescreens ( Configfile: Tfilename ) ;
var
  P: TControlPanel;
  B: TControlButton;
  S: Integer;
  X: Integer;
begin
  DeleteScreens;
  for s := 0 to Length(ConfigForm.Screens)-1 do
      begin
        P := TControlPanel.Create(Self);
        P.Parent := Self;
        P.Visible := false;
        P.Color := Configform.Screens[s].Color;
        if Configform.Screens[s].Graphic <> ''
           then if FileExistsUTF8(Configform.Screens[s].Graphic)
                then P.Background.Picture.LoadFromFile(Configform.Screens[s].Graphic);
        for x := 0 to  Length(Configform.Screens[s].Buttons)-1 do
            begin
              B := TControlButton.Create(Self);
              B.Parent := P;
              if FileExistsUTF8( Configform.Screens[s].Buttons[x].Graphic )
                 then begin B.Glyph.LoadFromFile(Configform.Screens[s].Buttons[x].Graphic);
                 B.Height := B.Glyph.Height;
                 end
              else B.Caption := Configform.Screens[s].Buttons[x].Caption;
              B.Font := ConfigForm.Fontdialog1.Font;
              B.Top := Configform.Screens[s].Buttons[x].Top;
              B.Left := Configform.Screens[s].Buttons[x].Left;
              B.Width := Configform.Screens[s].Buttons[x].Width;
              B.Height := Configform.Screens[s].Buttons[x].Height;
              B.Color := Configform.Screens[s].Buttons[x].Color;
              B.Action := Configform.Screens[s].Buttons[x].Action;
              B.Target := Configform.Screens[s].Buttons[x].Target;
              B.OnClick := @DoAction;
              P.ButtonList.Add(B);
            end;
        fScreenList.Add(P);
      end;
  fCurrentScreen := 0;
  TControlPanel(fScreenList[fCurrentScreen]).Visible := true;

  if VideoScreenBackground<>nil then
        if FileExistsUTF8(ConfigForm.VideoBackgroundEdit.Text)
          then VideoScreenBackground.BackgroundImage.Picture.LoadFromFile(ConfigForm.VideoBackgroundEdit.Text);

  if ConfigForm.CursorCheckBox.Checked
     then if WindowState=wsMaximized
          then Screen.Cursor := crNone;
  ScreenReset := ConfigForm.DefaultScreenCheckBox.Checked;
  ResetInterval := ConfigForm.DefaultScreenSpinEdit.Value;
end;

procedure Tcontrolscreen.Openconfiguration;
begin
  if Screen.MonitorCount=1
    then ConfigForm.MonitorInfoLabel.Caption := IntToStr(Screen.MonitorCount) + ' monitor detected'
  else ConfigForm.MonitorInfoLabel.Caption := IntToStr(Screen.MonitorCount) + ' monitors detected';
  WindowState := wsNormal;
  Screen.Cursor:=crDefault;
  BorderStyle:=bsSizeable;
  ConfigForm.Show;
end;

procedure TControlScreen.Button1click ( Sender: Tobject ) ;
begin
  Videoplayer.Paused:=true;
End;


procedure Tcontrolscreen.Formclose ( Sender: Tobject;
  var Closeaction: Tcloseaction ) ;
begin
  VideoPlayer.Free;
End;

procedure Tcontrolscreen.Formcreate ( Sender: Tobject ) ;
var
  f: TextFile;
begin
  VideoPlayer := TVideoPlayer.Create(self);
  fScreenList := Tlist.Create;
  fIdleTime := 0;
  IdleTimer := TTimer.Create(self);
  IdleTimer.Interval := 60000;
  IdleTimer.OnTimer := @OnIdleTimer;
  IdleTimer.Enabled := true;  // enable this to reset to initial screen after a delay
  fResetInterval := 5; // time in minutes after which the initial screen will be shown if no video running
  WindowState := wsMaximized;
  ConfigChecked := false;
  inputConf := GetTempDir + DirectorySeparator + 'input.conf';
  AssignFile(f, inputConf);
  Rewrite(f);
  WriteLn(f, 'MOUSE_BTN0 quit');
  CloseFile(f);
End;

procedure Tcontrolscreen.Formdestroy ( Sender: Tobject ) ;
begin
  DeleteScreens;
  fScreenList.Free;
  IdleTimer.Free;
End;


{ TVideoPlayer }

procedure Tvideoplayer.Setfilename ( const Avalue: String ) ;
begin
  if FFilename=AValue then exit;
  FFilename:=AValue;
  if Running then
    SendMPlayerCommand('loadfile ');
end;

procedure Tvideoplayer.Setloop ( const Avalue: Integer ) ;
begin
  if FLoop=AValue then exit;
  FLoop:=AValue;
  if Running then
    SendMPlayerCommand('loop '+IntToStr(FLoop));
end;

procedure Tvideoplayer.Setmplayerpath ( const Avalue: String ) ;
begin
  if FMPlayerPath=AValue then exit;
  FMPlayerPath:=AValue;
end;

procedure Tvideoplayer.Setpaused ( const Avalue: Boolean ) ;
begin
  if FPaused=AValue then exit;
  if Running then begin
    FPaused:=AValue;
    SendMPlayerCommand('pause');
  end;
end;

procedure Tvideoplayer.Onreadtimer ( Sender: Tobject ) ;
begin
  if fPlayerProcess<>nil then exit;
  debugln('ReadTimer');
  //ReadMPlayerOutput;
  ReadTimer.Enabled := fPlayerProcess.Running;
end;

procedure Tvideoplayer.Setvolume ( const Avalue: Integer ) ;
begin
  if FVolume=AValue then exit;
  FVolume:=AValue;
  if Running then
    SendMPlayerCommand('volume '+IntToStr(FVolume)+' 1');
end;

procedure Tvideoplayer.Readmplayeroutput;  // Mplayer will hang in Windows unless output is read
var
  Byteswaiting: Longword;
  ExePath: string;
begin
  if fPlayerProcess <> nil then
    if fPlayerProcess.Running then
           begin
             byteswaiting := fPlayerProcess.Output.NumBytesAvailable;
             while Byteswaiting>0 do
                   begin
                     if Byteswaiting>255 then byteswaiting := 255;
                     setlength(Exepath, Byteswaiting);
                     fPlayerProcess.Output.Read(Exepath[1], Byteswaiting);
                     debugln(Exepath);
                     byteswaiting := fPlayerProcess.Output.NumBytesAvailable;
                   end;
           end;
end;

constructor Tvideoplayer.Create ( Theowner: Tcomponent ) ;
begin
  inherited Create ( Theowner ) ;
  ReadTimer := TTimer.Create(self);
  ReadTimer.OnTimer := @OnReadTimer;
  ReadTimer.Interval := 500;
  ReadTimer.Enabled := false;
  fMPlayerPath:='mplayer';
end;

destructor Tvideoplayer.Destroy;
begin
  Stop;
  inherited Destroy;
end;

procedure Tvideoplayer.Sendmplayercommand ( Cmd: String ) ;
begin
  if Cmd='' then exit;
  if not Running then exit;
  if Cmd[length(Cmd)]<>LineEnding then Cmd:=Cmd+LineEnding;
  fPlayerProcess.Input.Write(Cmd[1],length(Cmd));
end;

function Tvideoplayer.Running: Boolean;
begin
  Result:=(fPlayerProcess<>nil) and fPlayerProcess.Running;
end;

procedure Tvideoplayer.Play;
var
  Exepath: String;
  Byteswaiting: Longword;
  inputparams: string;
begin
  if Running and Paused then begin
    Paused:=false;
    exit;
  end;

 // if Playing then exit;

  if fPlayerProcess<>nil then
    fPlayerProcess.Terminate(0);
    //raise Exception.Create('Tvideoplayer.Play fPlayerProcess still exists');

  ExePath:=MPlayerPath;
  if not FilenameIsAbsolute(ExePath) then
    ExePath:=FindDefaultExecutablePath(ExePath);
  if not FileExistsUTF8(ExePath) then
    raise Exception.Create('mplayer not found');

  inputparams := '';
  if ConfigForm.ClickToStopPlayCheckBox.Checked
    then inputparams := ' -input conf="' + inputConf + '"';
  fPlayerProcess:=TProcessUTF8.Create(Self);
  fPlayerProcess.Options:=fPlayerProcess.Options+[poUsePipes, poNoConsole, poStderrToOutPut];
  //fPlayerProcess.CommandLine:='"' + ExePath+'" -slave -quiet ' +' "'+Filename+'" -geometry 600x450';// -fs';      //  fPlayerProcess.CommandLine:=ExePath+' -slave -quiet -wid '+IntToStr(CurWindowID)+' "'+Filename+'" -fs';
  fPlayerProcess.CommandLine:='"' + ExePath+'" -slave -quiet ' +' "'+Filename+'" -fs -adapter 2' + inputparams;// -fs';      //  fPlayerProcess.CommandLine:=ExePath+' -slave -quiet -wid '+IntToStr(CurWindowID)+' "'+Filename+'" -fs';
{DEBUG}  ExePath := fPlayerProcess.CommandLine;
  {$IFDEF LINUX} writeln('TCustomMPlayerControl.Play ',fPlayerProcess.CommandLine);
  {$ENDIF}
  ReadTimer.Enabled := true;
  fPlayerProcess.Execute;
  while fPlayerProcess.Running do
             begin
             byteswaiting := fPlayerProcess.Output.NumBytesAvailable;
             while Byteswaiting>0 do
                   begin
                     if Byteswaiting>255 then byteswaiting := 255;
                     setlength(Exepath, Byteswaiting);
                     fPlayerProcess.Output.Read(Exepath[1], Byteswaiting);
                     debugln(Exepath);
                     byteswaiting := fPlayerProcess.Output.NumBytesAvailable;
                   end;
           Application.ProcessMessages;
           end;
 end;

procedure Tvideoplayer.Stop;
begin
  if fPlayerProcess=nil then exit;
  FPaused:=false;
  ReadTimer.Enabled:=false;
  SendMPlayerCommand('quit');
  FreeAndNil(fPlayerProcess);
end;

function Tvideoplayer.Playing: Boolean;
begin
  Result:=(fPlayerProcess<>nil) and fPlayerProcess.Running and (not Paused);
end;

{ TControlButton }

procedure TControlButton.TextChanged;
var
  x: LongInt;
  c: String;
begin
  inherited TextChanged;
  c := Caption;
  if length(c)>0 then
     begin
      x := Pos('&', c);
      if (x > 0) and (c[x+1]<>'&')
         then Insert('&', c, x);
     end;
  Caption := c;
end;

constructor Tcontrolbutton.Create ( Theowner: Tcomponent ) ;
begin
  inherited Create ( Theowner ) ;
  fAction := 0;
  fTarget := '';
end;


{ TControlPanel }

constructor Tcontrolpanel.Create ( Theowner: Tcomponent ) ;
begin
  inherited Create ( Theowner ) ;
  fBackground := TImage.Create(self);
  fBackground.Parent := Self;
  fBackground.Align := alClient;
  fBackground.Stretch := true;
  Align := alClient;
  Visible := false;
  ButtonList := TList.Create;
  LabelList := TList.Create;
end;

destructor Tcontrolpanel.Destroy;
var
  X: Integer;
begin
  for x := 0 to ButtonList.Count-1 do
      TControlButton(ButtonList[x]).Free;
  for x := 0 to LabelList.Count-1 do
      TLabel(LabelList[x]).Free;
  ButtonList.Free;
  LabelList.Free;
  fBackground.Free;
  inherited Destroy;
end;

initialization
  {$I mainpanel.lrs}

end.

